home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 98 / 098.d81 / radac demo (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1992-01-01  |  7.7 KB  |  258 lines
  1. 10 poke55,00:poke56,140:clr
  2. 20 dn=peek(186):ifdn<8thendn=8
  3. 30 goto100
  4. 90 poke 214,yy:poke211,xx:print"[145]";:return
  5. 95 :
  6. 100 sys57812"radac.o",dn,0:poke780,0:poke781,0:poke782,152:sys65493
  7. 110 ci=0:rem ci=1, cache fetched: ci=0, no cache fetched
  8. 111 sys38912,"p",1,rt:ifrt>10thenl=111:goto9000
  9. 115 dim st%(400)
  10. 116 sp$="                          ":hv$=chr$(255)+chr$(255)+chr$(255)
  11. 117 hv$=hv$+hv$:hv$=hv$+hv$:hv$=hv$+hv$+chr$(255)
  12. 200 goto 2000
  13. 1000 print"any key continues[146]";
  14. 1010 poke 198,0:wait198,15:getq$:print"[145]":print"                             ";
  15. 1020 return
  16. 1100 :
  17. 1102 rem get routine: at$ =display:a1=1=alpha:al=fld len
  18. 1103 :
  19. 1110 a1$="":a2=0:ifa3<>1 then poke198,0
  20. 1115 xx=0:gosub90:gosub1295:poke204,0
  21. 1120 poke204,0:wait198,15:get a$
  22. 1125 poke204,1
  23. 1130 a=asc(a$):if a=20 thengosub1300:goto1195
  24. 1132 if a1=1 and a=145 then a2=4:goto1200
  25. 1133 if a1=1 and a=17  then a2=5:goto1200
  26. 1135 if a=145 or a=175 or a=147 then 1120
  27. 1140 if a=13then 1200
  28. 1141 if a<32 then 1120
  29. 1142 if a=95 then a2=9:goto1200
  30. 1144 if a=34 then 1120
  31. 1145 if a<91 then 1148
  32. 1146 if a<193 or a>218 then 1120
  33. 1148 if a1=1 then 1180
  34. 1150 if a$="."ora$="," then1180
  35. 1160 if a$ = "-" and len(a1$) = 0 then 1180
  36. 1170 if a < 48 or a > 60 then 1120
  37. 1180 if len(a1$)>al-1 then 1120
  38. 1190 a1$=a1$+a$
  39. 1195 gosub1295:ifa3<>1then 1120
  40. 1196 if len(a1$)=al then return
  41. 1197 goto 1120
  42. 1200 dv=0:l =len(a1$):a = 0:at = 0:p = 0:an = 1:gosub1295
  43. 1205 if a1=1 then return
  44. 1210 for i=1 to l:a$ = mid$(a1$,i,1)
  45. 1215 if a$="-" then an=-1:goto 1260
  46. 1220 ifa$=","then 1260
  47. 1230 if a$="."thendv=1:goto 1260
  48. 1240 if dv=0 then a=val(a$):at = at*10 + a
  49. 1250 if dv=1 then p=p+1:a=val(a$):at = at + a/(10^p)
  50. 1260 next:at=at*an:return
  51. 1295 print:print "[145]";at$;" ";a1$;"  [157][157]";:return
  52. 1300 l=len(a1$):ifl=0then return
  53. 1310 l=l-1:a1$=mid$(a1$,1,l):return
  54. 2000 poke53281,6:poke53280,6:print"",chr$(142)
  55. 2010 print "[147]        coupon tracker"
  56. 2020 print "        [163][163][163][163][163][163][163][163][163][163][163][163][163][163]"
  57. 2030 print tab(10);"1. fetch"
  58. 2032 print tab(10);"2. add  "
  59. 2034 print tab(10);"3. locate"
  60. 2036 print tab(10);"4. list  "
  61. 2038 print tab(10);"5. purge "
  62. 2040 print tab(10);"6. compress"
  63. 2042 print tab(10);"7. archive"
  64. 2044 print tab(10);"8. quit   "
  65. 2050 print "    enter number":poke198,0
  66. 2060 wait198,15:geta$
  67. 2070 if a$="1"thengosub3200:goto2000
  68. 2075 if a$="2"thengosub2500:goto2000
  69. 2080 if a$="3"thengosub3400:goto2000
  70. 2085 if a$="4"thengosub4200:goto2000
  71. 2090 if a$="5"thengosub4500:goto2000
  72. 2093 if a$="6"thengosub5000:goto2000
  73. 2095 if a$="7"thengosub3000:goto2000
  74. 2097 if a$="8"thengoto2200
  75. 2100 goto 2060
  76. 2200 print"[147]quit......":if ci then 2210
  77. 2201 close15:open15,8,15,"r0:hello connect=hello connect":input#15,er:close15
  78. 2202 ifer<>63thenend
  79. 2203 poke646,peek(53281):print"[147]load"chr$(34)"hello connect"chr$(34)",8"
  80. 2204 print"run"
  81. 2205 poke631,13:poke632,13:poke198,2:end
  82. 2210 print "    cache has data."
  83. 2220 print "    do you wish to archive? (y/n)":poke198,0
  84. 2230 wait198,15:geta$:if a$="n" then end
  85. 2240 goto2000
  86. 2497 :
  87. 2498 :rem add
  88. 2499 :
  89. 2500 if ci=0 then gosub2700
  90. 2510 print"[147] ":print"add new coupon":print"[163][163][163][163][163][163][163][163][163][163][163][163][163][163]"
  91. 2520 yy=7:xx=0:gosub90:print "enter:"
  92. 2530 a1=1:yy=8:xx=0:gosub90:al=25:at$="name= "
  93. 2540 print at$:gosub1100:pn$=a1$:yy=9:gosub90:at$="expiry date (yymmdd)="
  94. 2550 a1=0:al=6:printat$:gosub1100:ex=at
  95. 2560 yy=11:gosub90:print"for percent enter return"
  96. 2570 yy=12:gosub90:at$="amount= ":printat$:gosub1100
  97. 2580 if at<>0 then am%=at*100:st%=0:goto2600
  98. 2590 at$="[158]percent= ":gosub1100:am%=at+10000:st%=1:print""
  99. 2600 i=0
  100. 2605 i=i+1:ifst%(i)= 0then2610
  101. 2606 if i>400 then 2650
  102. 2607 goto2605
  103. 2610 st%(i)=1:ct%=int(1000+i)
  104. 2620 sys38912,"t",1,"a",pn$,am%,ex,ct%,rt:if rt>10 then l=2620:goto9000
  105. 2630 up=1:print chr$(13);"[153]    file number is";i;"":gosub1000:return
  106. 2640 ifrt<>65thenl=2640:goto9000
  107. 2650 print" file full: item not added":gosub1000:return
  108. 2700 print"[147]        building file!":pn$="":am%=0:ex=0:ct%=0:st%=0
  109. 2710 sys38912,"c",1,rt:sys38912,"o",1,"sifi",rt:ifrt>10thenl=2710:goto9000
  110. 2720 fori=1 to 400:st%(i)=st%:next
  111. 2740 ci=1:return
  112. 2997 :
  113. 2998 :rem archive
  114. 2999 :
  115. 3000 print"[147]archive.....":if ci=0 then 3100
  116. 3005 close15:open15,8,15,"i0":input#15,e,e$,t,s
  117. 3010 yy=8:xx=0:gosub90:a1=1:al= 8
  118. 3020 at$=" enter file name:":printat$:gosub1100:if len(a1$)=0 then return
  119. 3025 sys38912,"a","2"+ a1$,8,rt
  120. 3030 print:i=0:if rt>10 then l=3030:goto9000
  121. 3040 sys38912,"c",1,rt:ci=0:sys38912,"o",1,"i",rt:if rt>10thenl=3040:goto9000
  122. 3045 i=i+1:if i>400 then 3060
  123. 3050 sys38912,"t",1,"a",st%(i),rt:ifrt>10thenl=3050:goto9000
  124. 3055 print".";:goto3045
  125. 3060 sys38912,"a","1"+ a1$,8,rt:if rt>10 then l=3060:goto9000
  126. 3070 sys38912,"c",1,rt:return
  127. 3100 print "  no cache to archive"
  128. 3110 print "   request ignored!":gosub1000:return
  129. 3197 :
  130. 3198 :rem fetch
  131. 3199 :
  132. 3200 print"[147]fetch....":if ci=1 then 3250
  133. 3205 close15:open15,8,15,"i0":input#15,e,e$,t,s
  134. 3210 yy=8:xx=0:gosub90:a1=1:al=09:i=0
  135. 3220 at$=" enter file name:":printat$:gosub1100:iflen(a1$)=0then return
  136. 3225 print:  sys38912,"f","1"+ a1$,8,rt:if rt>10 then 3280
  137. 3230 o$="f":fori=1to400:sys38912,"t",1,o$,st%(i),rt:ifrt>10thenl=3230:goto9000
  138. 3232 print".";
  139. 3235 o$="r":next:sys38912,"f","2"+a1$,8,rt:ifrt>10thenl=3235:goto9000
  140. 3240 ci=1:return
  141. 3250 print "  cache has data."
  142. 3255 print "   do you want to archive?":print "      (y/n)":poke198,0
  143. 3260 wait198,15:geta$:if a$="n"then3205
  144. 3270 return
  145. 3280 ifrt<>238thenl=3225:goto9000
  146. 3300 print:print "file not found!":gosub1000:return
  147. 3387 :
  148. 3388 :rem locate
  149. 3389 :
  150. 3390 print"[147]locate.....":return
  151. 3400 gosub3390
  152. 3410 if ci=1 then 3440
  153. 3420 print"   no cache available,":print"     request ignored!":gosub1000
  154. 3430 return
  155. 3440 print " locate by ([158]n)ame or ([158]i)nventory #?":poke 198,0
  156. 3450 wait198,15:geta$:ifa$="n"then3610
  157. 3460 if a$ <> "i" then 3450
  158. 3463 al=3:a1=0:at$="enter number:":yy=8:xx=0:gosub90:printat$:gosub1100
  159. 3464 if at>400 or at<1 then print:print"[145]"tab(15);"       ":goto3463
  160. 3465 n=at:ifst%(n)<>1then 3600
  161. 3470 o$="f":ct%=n+1000
  162. 3480 sys38912,"s",1," ",pn$," ",am%," ",ex,"=",ct%,rt
  163. 3481 ifrt>10then l=3480:goto9000
  164. 3500 gosub3390:at$="item found..":print "";at$
  165. 3510 print "inventory item no.";n;""
  166. 3520 print "product: ";pn$
  167. 3530 yy=int(ex/10000):mm=int((ex-yy*10000)/100)
  168. 3540 dd=int(ex-(yy*10000)-(mm*100))
  169. 3550 if am%>9999then print "value =";am%-10000;"percent":goto3580
  170. 3560 p=am%/100+.001:p$=str$(p):p$=left$(p$,len(p$)-1)
  171. 3570 print  "value = $";p$
  172. 3580 print "expiry date: ";mm;"[157]/";dd;"[157]/";yy
  173. 3590 gosub4000:return
  174. 3600 gosub3390:print"  item not available!":gosub1000:return
  175. 3610 a1=1:al=25:a1$="":at$="enter product: ":yy=8:xx=0:gosub90:gosub1100
  176. 3620 i=0:o$="f":al$=left$(a1$+sp$,25):ah$=left$(a1$+hv$,25):print"[158]":j=0
  177. 3630 i=i+1:sys38912,"t",1,o$,pn$,am%,ex,ct%,rt:if rt>10 then3700
  178. 3640 o$="r":ifpn$<al$then3630
  179. 3645 if ct%>1999 then 3630
  180. 3650 if pn$>ah$then 3630
  181. 3655 print pn$;:if am%>9999then print tab(27);am%-10000;"%";:goto3670
  182. 3660 p=am%/100+.001:p$=str$(p):p$=left$(p$,len(p$)-1):print tab(26);"$";p$;
  183. 3670 print tab(35);ct%-1000
  184. 3680 j=j+1:ifj>11 then gosub1000:j=0:gosub3390
  185. 3690 goto3630
  186. 3700 print "  end of search!":gosub1000:return
  187. 4000 print" ([158]c)ontinue  ...  ([158]d)elete item":poke198,0
  188. 4010 wait 198,15:geta$:if a$="c"then return
  189. 4020 if a$<>"d"then 4010
  190. 4030 e=ct%-1000:ct%=ct%+1000:sys38912,"t",1,"w",pn$,am%,ex,ct%,rt
  191. 4040 if rt>10 thenl=4030:goto9000
  192. 4050 st%(e)=2:return
  193. 4197 :
  194. 4198 :rem list
  195. 4199 :
  196. 4200 print "[147]list......":if ci=0then4390
  197. 4205 print" ([158]a)ctive or ([158]p)urged items":poke 198,0
  198. 4210 wait 198,15:geta$:if a$="a" then cl=1000:ch=1500:goto4230
  199. 4215 if a$<>"p"then 4210
  200. 4220 cl=2000:ch=2999
  201. 4230 o$="f":gosub4400
  202. 4240 sys38912,"t",1,o$,pn$,am%,ex,ct%,rt:if rt>10 then 4350
  203. 4250 o$="r":if ct%<cl or ct%>ch then 4240
  204. 4255 yy=int(ex/10000):mm=int((ex-yy*10000)/100)
  205. 4256 dd=int(ex-(yy*10000)-(mm*100))
  206. 4260 print pn$;tab(34);ct%-cl
  207. 4270 print "  expiry:";mm;"[157]/";dd;"[157]/";yy;
  208. 4280 if am%>9999then print tab(25);am%-10000;"%":goto4300
  209. 4285 p=am%/100+.001:p$=str$(p):p$=left$(p$,len(p$)-1)
  210. 4291 print tab(25);"$";p$
  211. 4300 print:j=j+1:if j<06 then 4240
  212. 4310 gosub1000:gosub4400:goto4240
  213. 4350 print "    end of list":gosub1000:return
  214. 4390 print"  no cache available.":print"    request ignored!"
  215. 4395 gosub1000:return
  216. 4400 print"[147]              coupon list"
  217. 4405 print "              [183][183][183][183][183][183][183][183][183][183][183]":j=0:return
  218. 4487 :
  219. 4488 :rem purge
  220. 4489 :
  221. 4490 print "[147]purge.....":return
  222. 4500 gosub4490:a1=0:al=6:at$="enter date (yymmdd):":o$="f"
  223. 4502 if ci=0 then4600
  224. 4510 yy=4:xx=0:gosub90:gosub1100:i=0:yy=8:gosub90:k=0
  225. 4512 if at<300000thenat =at+1000000
  226. 4515 print "  number deleted: ";k
  227. 4520 i=i+1:sys38912,"t",1,o$,pn$,am%,ex,ct%,rt:if rt>10 then 4580
  228. 4530 o$="r":if ct%<1000 or ct%>1500 then 4520
  229. 4535 if ex=999999then4520
  230. 4537 if ex<300000thenex =ex+1000000
  231. 4540 if ex>at then 4520
  232. 4550 j=ct%-1000:st%(j)=2:ct%=ct%+1000:ifex>999999thenex=ex-1000000
  233. 4560 sys38912,"t",1,"w",pn$,am%,ex,ct%,rt:if rt>10 then l=4560:goto9000
  234. 4570 k=k+1:print "[145]";k;"    ":goto4520
  235. 4580 if rt<>65 then l=4520:goto9000
  236. 4590 gosub1000:return
  237. 4600 gosub4490:print "  no cache to available,"
  238. 4610 print "   request ignored!":gosub1000:return
  239. 4997 :
  240. 4998 :rem compress
  241. 4999 :
  242. 5000 print"[147]compress......":ifci=0then 5100
  243. 5010 sys38912,"t",1,"c",pn$,am%,ex,ct%,rt:ifrt>10then 5090
  244. 5020 if ct%>1999 then goto 5050
  245. 5030 sys38912,"r",rt:ifrt>10then 5090
  246. 5040 goto 5020
  247. 5050 j=ct%-2000:st%(j)=0:print pn$;tab(30);ct%-2000
  248. 5060 sys38912,"d",rt:ifrt>10then 5090
  249. 5070 goto5020
  250. 5090 if rt<>65 then l=5000:goto9000
  251. 5095 gosub1000:return
  252. 5100 print"  no cache available,":print"   request ignored!"
  253. 5110 gosub 1000:return
  254. 9000 print"[147]radac error encountered"
  255. 9010 print "rt=";rt;" line #";l
  256. 9020 print "can't continue  ":gosub1000:sys42100
  257. 10000 open15,8,15,"s0:radac demo":close15:save"radac demo",8:end
  258.